(define parser-filename "NONE")
(define strip #t)

(define (strip-token t)
  (if strip
      (if (atomic-token? t)
	  (car (token-args t))
	  (begin (error 'strip-token "never happens?")
		 (token-type t)))
      (syx (token-type t)
	   (car (token-args t))
	   `((src . ,parser-filename)
	     (lin . ,(car (token-location t)))
	     (col . ,(cdr (token-location t)))))))

(define (read-s* ts)
  (let loop ((collect (make-collector)) (ts ts))
    (if (null? ts)
	(collector-get collect)
	(let-values (((s ts) (read-s ts)))
	  (collect-object! collect s)
	  (loop collect ts)))))

(define (read-s ts)
  (if (null? ts)
      (error 'read-s "?")
      (let ((t (car ts)) (ts (cdr ts)))
	(cond ((atomic-token? t)
	       (values (strip-token t) ts))
	      ((mark-token? t)
	       (let-values (((s ts) (read-s ts)))
		 (values (list (strip-token t) s) ts)))
	      ((open-token? t)
	       (read-s+/close ts))
	      ((close-token? t)
	       (error 'read-s "too many closed brackets" (token-location t)))
	      (else
	       (error 'read-s "unknown token" (token-location t) t))))))

(define (read-s+/close ts)
  (if (null? ts)
      (error 'read-s+/close "?")
      (let ((t (car ts)) (ts (cdr ts)))
	(cond ((close-token? t) (values '() ts))
	      (else
	       (let-values (((s ts) (read-s (cons t ts))))
		 (let ((collect (make-collector)))
		   (collect-object! collect s)
		   (read-s+ collect ts))))))))

(define (read-s+ collect ts)
  (if (null? ts)
      (error 'read-s+ "?")
      (let ((t (car ts)) (ts (cdr ts)))
	(cond ((close-token? t)
	       (values (collector-get collect) ts))
	      ((dot-token? t)
	       (let-values (((s ts) (read-s (cons t ts))))
		 (values (append (collector-get collect) s) ts)))
	      (else
	       (let-values (((s ts) (read-s (cons t ts))))
		 (collect-object! collect s)
		 (read-s+ collect ts)))))))
